home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / EZDSL200.ZIP / EZDSLDBL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-03-13  |  13.0 KB  |  473 lines
  1. {===EZDSLDBL==========================================================
  2.  
  3. Part of the Delphi Structures Library--the double linked list.
  4.  
  5. EZDSLDBL is Copyright (c) 1993, 1996 by  Julian M. Bucknall
  6.  
  7. VERSION HISTORY
  8. 13Mar96 JMB 2.00 release for Delphi 2.0
  9. 12Nov95 JMB 1.01 fixed Iterate bug
  10. 18Jun95 JMB 1.00 conversion of EZStrucs to Delphi
  11. ======================================================================}
  12. { Copyright (c) 1993, 1996, Julian M. Bucknall. All Rights Reserved   }
  13.  
  14. unit EZDSLDbl;
  15.  
  16. {$I EZDSLDEF.INC}
  17. {---Place any compiler options you require here-----------------------}
  18.  
  19.  
  20. {---------------------------------------------------------------------}
  21. {$I EZDSLOPT.INC}
  22.  
  23. interface
  24.  
  25. uses
  26.   SysUtils,
  27.   WinTypes,
  28.   WinProcs,
  29.   Classes,
  30.   EZDSLCts,
  31.   EZDSLSup,
  32.   EZDSLBse;
  33.  
  34. type
  35.  
  36.   TDList = class(TAbstractContainer)
  37.     {-Double linked list object}
  38.     private
  39.       FIsSorted: boolean;
  40.       BF, AL  : PNode;
  41.  
  42.     public
  43.       constructor Create(DataOwner : boolean); override;
  44.       constructor Clone(Source : TAbstractContainer;
  45.                         DataOwner : boolean; NewCompare : TCompareFunc); override;
  46.  
  47.       function  Delete(Cursor : TListCursor) : TListCursor;
  48.       procedure Empty; override;
  49.       function  Erase(Cursor : TListCursor) : TListCursor;
  50.       function  Examine(Cursor : TListCursor) : pointer;
  51.       procedure InsertAfter(Cursor : TListCursor; aData : pointer);
  52.       procedure InsertBefore(Cursor : TListCursor; aData : pointer);
  53.       procedure InsertSorted(aData : pointer);
  54.       function  IsAfterLast(Cursor : TListCursor) : boolean;
  55.       function  IsBeforeFirst(Cursor : TListCursor) : boolean;
  56.       function  Iterate(Action : TIterator; Backwards : boolean;
  57.                         ExtraData : pointer) : pointer;
  58.       procedure Join(Cursor : TListCursor; List : TDList);
  59.       function  Next(Cursor : TListCursor) : TListCursor;
  60.       function  Prev(Cursor : TListCursor) : TListCursor;
  61.       function  Replace(Cursor : TListCursor; aData : pointer) : pointer;
  62.       function  Search(var Cursor : TListCursor; aData : pointer) : boolean;
  63.       function  SetBeforeFirst : TListCursor;
  64.       function  SetAfterLast : TListCursor;
  65.       function  Split(Cursor : TListCursor) : TDList;
  66.  
  67.       {properties}
  68.       property IsSorted: boolean
  69.          read FIsSorted;
  70.   end;
  71.  
  72. implementation
  73.  
  74. {-An iterator for cloning a double linked list}
  75. function DListClone(SL : TAbstractContainer;
  76.                     aData : pointer;
  77.                     NSL : pointer) : boolean; far;
  78.   var
  79.     NewList : TDList absolute NSL;
  80.     NewData : pointer;
  81.   begin
  82.     Result := true;
  83.     with NewList do
  84.       begin
  85.         if IsDataOwner then
  86.              NewData := DupData(aData)
  87.         else NewData := aData;
  88.         try
  89.           InsertBefore(SetAfterLast, NewData);
  90.         except
  91.           DisposeData(NewData);
  92.           raise;
  93.         end;
  94.       end;
  95.   end;
  96.  
  97. {-An iterator for cloning a SORTED double linked list}
  98. function DListSortedClone(SL : TAbstractContainer;
  99.                           aData : pointer;
  100.                           NSL : pointer) : boolean; far;
  101.   var
  102.     NewList : TDList absolute NSL;
  103.     NewData : pointer;
  104.   begin
  105.     Result := true;
  106.     with NewList do
  107.       begin
  108.         if IsDataOwner then
  109.              NewData := DupData(aData)
  110.         else NewData := aData;
  111.         try
  112.           InsertSorted(NewData);
  113.         except
  114.           DisposeData(NewData);
  115.           raise;
  116.         end;
  117.       end;
  118.   end;
  119.  
  120. {=TDList==============================================================}
  121. constructor TDList.Create(DataOwner : boolean);
  122.   begin
  123.     NodeSize := 12;
  124.     inherited Create(DataOwner);
  125.     BF := acNewNode(nil);
  126.     FCount := 0;
  127.     AL := acNewNode(nil);
  128.     FCount := 0;
  129.     BF^.FLink := AL;
  130.     BF^.BLink:= BF;
  131.     AL^.FLink := AL;
  132.     AL^.BLink:= BF;
  133.     FIsSorted := true;
  134.   end;
  135. {--------}
  136. constructor TDList.Clone(Source : TAbstractContainer;
  137.                          DataOwner : boolean;
  138.                          NewCompare : TCompareFunc);
  139.   var
  140.     OldList : TDList absolute Source;
  141.   begin
  142.     Create(DataOwner);
  143.     Compare := NewCompare;
  144.     DupData := OldList.DupData;
  145.     DisposeData := OldList.DisposeData;
  146.  
  147.     if not (Source is TDList) then
  148.       RaiseError(escBadSource);
  149.  
  150.     if OldList.IsEmpty then Exit;
  151.  
  152.     if OldList.IsSorted then
  153.          OldList.Iterate(DListSortedClone, false, Self)
  154.     else OldList.Iterate(DListClone, false, Self);
  155.   end;
  156. {--------}
  157. function  TDList.Delete(Cursor : TListCursor) : TListCursor;
  158.   var
  159.     Temp : PNode;
  160.   begin
  161.     {$IFDEF DEBUG}
  162.     Assert((not IsBeforeFirst(Cursor)) and (not IsAfterLast(Cursor)), ascDeleteEdges);
  163.     {$ENDIF}
  164.     Temp := PNode(Cursor);
  165.     Cursor := Next(Cursor);
  166.     Temp^.BLink^.FLink := PNode(Cursor);
  167.     PNode(Cursor)^.BLink := Temp^.BLink;
  168.     acDisposeNode(Temp);
  169.     Delete := Cursor;
  170.     if IsEmpty then
  171.       FIsSorted := true;
  172.   end;
  173. {--------}
  174. procedure TDList.Empty;
  175.   var
  176.     Cursor : TListCursor;
  177.   begin
  178.     if not IsEmpty then
  179.       begin
  180.         Cursor := Next(SetBeforeFirst);
  181.         while not IsAfterLast(Cursor) do
  182.           Cursor := Erase(Cursor);
  183.       end;
  184.     if InDone then
  185.       begin
  186.         if Assigned(BF) then
  187.           acDisposeNode(BF);
  188.         if Assigned(AL) then
  189.           acDisposeNode(AL);
  190.       end;
  191.   end;
  192. {--------}
  193. function  TDList.Erase(Cursor : TListCursor) : TListCursor;
  194.   begin
  195.     if IsDataOwner then
  196.       DisposeData(Examine(Cursor));
  197.     Erase := Delete(Cursor);
  198.   end;
  199. {--------}
  200. function  TDList.Examine(Cursor : TListCursor) : pointer;
  201.   begin
  202.     {$IFDEF DEBUG}
  203.     Assert((not IsBeforeFirst(Cursor)) and (not IsAfterLast(Cursor)), ascExamineEdges);
  204.     {$ENDIF}
  205.     Examine := PNode(Cursor)^.Data;
  206.   end;
  207. {--------}
  208. procedure TDList.InsertAfter(Cursor : TListCursor; aData : pointer);
  209.   var
  210.     Node : PNode;
  211.   begin
  212.     {$IFDEF DEBUG}
  213.     Assert(not IsAfterLast(Cursor), ascInsertEdges);
  214.     {$ENDIF}
  215.     Node := acNewNode(aData);
  216.     Node^.FLink := PNode(Cursor)^.FLink;
  217.     Node^.BLink:= PNode(Cursor);
  218.     PNode(Cursor)^.FLink := Node;
  219.     Node^.FLink^.BLink := Node;
  220.     FIsSorted := false;
  221.   end;
  222. {--------}
  223. procedure TDList.InsertBefore(Cursor : TListCursor; aData : pointer);
  224.   var
  225.     Node : PNode;
  226.   begin
  227.     {$IFDEF DEBUG}
  228.     Assert(not IsBeforeFirst(Cursor), ascInsertEdges);
  229.     {$ENDIF}
  230.     Node := acNewNode(aData);
  231.     Node^.FLink := PNode(Cursor);
  232.     Node^.BLink:= PNode(Cursor)^.BLink;
  233.     PNode(Cursor)^.BLink := Node;
  234.     Node^.BLink^.FLink := Node;
  235.     FIsSorted := false;
  236.   end;
  237. {--------}
  238. procedure TDList.InsertSorted(aData : pointer);
  239.   var
  240.     Walker    : TListCursor;
  241.   begin
  242.     if not IsSorted then
  243.       begin
  244.         Walker := SetAfterLast;
  245.         InsertBefore(Walker, aData);
  246.       end
  247.     else {the list is sorted}
  248.       begin
  249.         if Search(Walker, aData) then
  250.           RaiseError(escInsertDup)
  251.         else
  252.           begin
  253.             InsertBefore(Walker, aData);
  254.             FIsSorted := true;
  255.           end;
  256.       end;
  257.   end;
  258. {--------}
  259. function  TDList.IsAfterLast(Cursor : TListCursor) : boolean;
  260.   begin
  261.     IsAfterLast := (PNode(Cursor) = AL);
  262.   end;
  263. {--------}
  264. function  TDList.IsBeforeFirst(Cursor : TListCursor) : boolean;
  265.   begin
  266.     IsBeforeFirst := (PNode(Cursor) = BF);
  267.   end;
  268. {--------}
  269. function  TDList.Iterate(Action : TIterator; Backwards : boolean;
  270.                          ExtraData : pointer) : pointer;
  271.   var
  272.     Walker : TListCursor;
  273.   begin
  274.     if Backwards then
  275.       begin
  276.         Walker := Prev(SetAfterLast);
  277.         while not IsBeforeFirst(Walker) do
  278.           if Action(Self, Examine(Walker), ExtraData) then      {!!.01}
  279.             Walker := Prev(Walker)
  280.           else
  281.             begin
  282.               Result := Examine(Walker);
  283.               Exit;
  284.             end;
  285.       end
  286.     else
  287.       begin
  288.         Walker := Next(SetBeforeFirst);
  289.         while not IsAfterLast(Walker) do
  290.           if Action(Self, Examine(Walker), ExtraData) then      {!!.01}
  291.             Walker := Next(Walker)
  292.           else
  293.             begin
  294.               Result := Examine(Walker);
  295.               Exit;
  296.             end;
  297.       end;
  298.     Result := nil;                                              {!!.01}
  299.   end;
  300. {--------}
  301. procedure TDList.Join(Cursor : TListCursor; List : TDList);
  302.   var
  303.     Walker : TListCursor;
  304.     Data   : pointer;
  305.   begin
  306.     {$IFDEF DEBUG}
  307.     Assert(not IsAfterLast(Cursor), ascCannotJoinHere);
  308.     Assert(List.IsDataOwner = IsDataOwner, ascCannotJoinData);
  309.     {$ENDIF}
  310.     if not Assigned(List) then Exit;
  311.  
  312.     if not List.IsEmpty then
  313.       begin
  314.         {if we are sorted, add new nodes in sorted order}
  315.         if {Self.}IsSorted then
  316.           begin
  317.             Walker := List.Next(List.SetBeforeFirst);
  318.             while not List.IsAfterLast(Walker) do
  319.               begin
  320.                 Data := List.Examine(Walker);
  321.                 Walker := List.Delete(Walker);
  322.                 InsertSorted(Data);
  323.               end;
  324.           end
  325.         else
  326.           begin
  327.             List.AL^.BLink^.FLink := PNode(Cursor)^.FLink;
  328.             PNode(Cursor)^.FLink^.BLink := List.AL^.BLink;
  329.             PNode(Cursor)^.FLink := List.BF^.FLink;
  330.             PNode(Cursor)^.FLink^.BLink := PNode(Cursor);
  331.             inc(FCount, List.Count);
  332.             {patch up List to be empty}
  333.             with List do
  334.               begin
  335.                 BF^.FLink := AL;
  336.                 AL^.BLink := BF;
  337.                 FCount := 0;
  338.               end;
  339.           end;
  340.       end;
  341.     List.Free;
  342.   end;
  343. {--------}
  344. function  TDList.Next(Cursor : TListCursor) : TListCursor;
  345.   begin
  346.     {$IFDEF DEBUG}
  347.     Assert(not IsAfterLast(Cursor), ascAlreadyAtEnd);
  348.     {$ENDIF}
  349.     Next := TListCursor(PNode(Cursor)^.FLink);
  350.   end;
  351. {--------}
  352. function  TDList.Prev(Cursor : TListCursor) : TListCursor;
  353.   begin
  354.     {$IFDEF DEBUG}
  355.     Assert(not IsBeforeFirst(Cursor), ascAlreadyAtStart);
  356.     {$ENDIF}
  357.     Prev := TListCursor(PNode(Cursor)^.BLink);
  358.   end;
  359. {--------}
  360. function  TDList.Replace(Cursor : TListCursor; aData : pointer) : pointer;
  361.   begin
  362.     {$IFDEF DEBUG}
  363.     Assert((not IsBeforeFirst(Cursor)) and (not IsAfterLast(Cursor)), ascReplaceEdges);
  364.     {$ENDIF}
  365.     if IsSorted then
  366.       begin
  367.         Replace := Examine(Cursor);
  368.         Delete(Cursor);
  369.         InsertSorted(aData);
  370.       end
  371.     else
  372.       with PNode(Cursor)^ do
  373.         begin
  374.           Replace := Data;
  375.           Data := aData;
  376.         end;
  377.   end;
  378. {--------}
  379. function TDList.Search(var Cursor : TListCursor; aData : pointer) : boolean;
  380.   var
  381.     Walker       : TListCursor;
  382.     CompResult   : integer;
  383.     StillLooking : boolean;
  384.     Found        : boolean;
  385.   begin
  386.     Walker := SetBeforeFirst;
  387.     if IsSorted then
  388.       begin
  389.         CompResult := 1;
  390.         while (CompResult > 0) do
  391.           begin
  392.             Walker := Next(Walker);
  393.             if IsAfterLast(Walker) then
  394.                  CompResult := -1
  395.             else CompResult := Compare(aData, Examine(Walker));
  396.           end;
  397.         Cursor := Walker;
  398.         Search := (CompResult = 0);
  399.       end
  400.     else {the list is not sorted}
  401.       begin
  402.         StillLooking := true;
  403.         Found := false;
  404.         while StillLooking and (not Found) do
  405.           begin
  406.             Walker := Next(Walker);
  407.             if IsAfterLast(Walker) then
  408.                  StillLooking := false
  409.             else Found := (Compare(aData, Examine(Walker)) = 0);
  410.           end;
  411.         Cursor := Walker;
  412.         Search := Found;
  413.       end;
  414.   end;
  415. {--------}
  416. function  TDList.SetBeforeFirst : TListCursor;
  417.   begin
  418.     SetBeforeFirst := TListCursor(BF);
  419.   end;
  420. {--------}
  421. function  TDList.SetAfterLast : TListCursor;
  422.   begin
  423.     SetAfterLast := TListCursor(AL);
  424.   end;
  425. {--------}
  426. function  TDList.Split(Cursor : TListCursor) : TDList;
  427.   var
  428.     TempCount : longint;
  429.     NewList   : TDList;
  430.     Walker    : TListCursor;
  431.     LastNodeLeftBehind,
  432.     JoinNode,
  433.     LastNode  : PNode;
  434.   begin
  435.     {$IFDEF DEBUG}
  436.     Assert((not IsBeforeFirst(Cursor)) and (not IsAfterLast(Cursor)), ascSplitEdges);
  437.     {$ENDIF}
  438.     NewList := TDList(TAbstractContainerClass(ClassType).Create(IsDataOwner));
  439.     NewList.Compare := Compare;
  440.     NewList.DupData := DupData;
  441.     NewList.DisposeData := DisposeData;
  442.     Result := NewList;
  443.  
  444.     LastNodeLeftBehind := PNode(Cursor)^.BLink;
  445.  
  446.     TempCount := 0;
  447.     Walker := Cursor;
  448.     JoinNode := PNode(Walker);
  449.     while not IsAfterLast(Walker) do
  450.       begin
  451.         inc(TempCount);
  452.         Walker := Next(Walker);
  453.       end;
  454.  
  455.     LastNode := PNode(Prev(Walker));
  456.  
  457.     JoinNode^.BLink := NewList.BF;
  458.     NewList.BF^.FLink := JoinNode;
  459.     LastNode^.FLink := NewList.AL;
  460.     NewList.AL^.BLink := LastNode;
  461.     NewList.FCount := TempCount;
  462.     NewList.FIsSorted := IsSorted;
  463.  
  464.     dec(FCount, TempCount);
  465.     LastNodeLeftBehind^.FLink := AL;
  466.     AL^.BLink := LastNodeLeftBehind;
  467.     if IsEmpty then
  468.       FIsSorted := true;
  469.   end;
  470. {---------------------------------------------------------------------}
  471.  
  472. end.
  473.